Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/unix/volume3/modula_pp

Internet Message Format | 1986-11-30 | 36.4 KB

From: Ken Yap  <talcott!seismo!rochester!ken>
Subject: Modula-2 prettyprinter
Newsgroups: mod.sources
Approved: [e-mail]

Mod.sources:  Volume 3, Issue 35
Submitted by: Ken Yap  <talcott!seismo!rochester!ken>


This is the source for a Modula-2 prettyprinter, written in Modula-2.
I believe everything needed, including a Makefile, is in the shar archive
below.

    Cheers, Ken
--
#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    README
#    Makefile
#    m2p.mod
#    InOut.def
#    InOut.c
# This archive created: Sat Nov  2 02:03:56 1985
# By:    Ken Yap (U of Rochester, CS Dept)
export PATH; PATH=/bin:$PATH
if test -f 'README'
then
    echo shar: over-writing existing file "'README'"
fi
cat << \SHAR_EOF > 'README'
This is a Modula-2 prettyprinter. It takes a valid program from input
and writes a formatted version to output. If it runs into syntax errors
it may stop formatting and copy the rest of the file verbatim.  It
isn't exactly the best example of modularity, but...

It uses the standard InOut module. An implementation of this module and
Makefile for the DECWRL compiler under 4.2 BSD is included as an
example.  You may need to make some minor changes for other Modula-2
systems.

I wanted to put more stuff in but I got tired of having it around so I
am pushing it out the door. I would be grateful if you would report any
bugs or enhancements so that I can collect and redistribute the
changes.  I have tried to make it as OS independent as possible.
Please remember that Modula-2 runs on many systems. If you make changes
that are specific to a machine/OS, please put the changes in specific
modules or procedures.

That is all, I think. Have fun.

    Ken Yap
    Dept. of Comp. Sci., U of Rochester
    1st November 1985

    UUCP: ..!{seismo,decvax,allegra}!rochester!ken
    ARPA: [e-mail]
SHAR_EOF
if test 1090 -ne "`wc -c 'README'`"
then
    echo shar: error transmitting "'README'" '(should have been 1090 characters)'
fi
if test -f 'Makefile'
then
    echo shar: over-writing existing file "'Makefile'"
fi
cat << \SHAR_EOF > 'Makefile'
m2p:    m2p.o InOut.o
    mod -g -o m2p m2p.o InOut.o

m2p.o:    m2p.mod
    mod -s -g -c m2p.mod

InOut.o:    InOut.c
    cc -O -c InOut.c
SHAR_EOF
if test 122 -ne "`wc -c 'Makefile'`"
then
    echo shar: error transmitting "'Makefile'" '(should have been 122 characters)'
fi
if test -f 'm2p.mod'
then
    echo shar: over-writing existing file "'m2p.mod'"
fi
cat << \SHAR_EOF > 'm2p.mod'
MODULE Modula2PrettyPrinter;

FROM InOut IMPORT
    Done, Read, Write, WriteLn, WriteString;

(*
**      Modula-2 Prettyprinter, November 1985.
**
**      by Ken Yap, U of Rochester, CS Dept.
**
**      Permission to copy, modify, and distribute, but not for profit,
**      is hereby granted, provided that this note is included.
**
**      adapted from a Pascal Program Formatter
**      by J. E. Crider, Shell Oil Company,
**      Houston, Texas 77025
**
**      This program formats Modula-2 programs according
**      to structured formatting principles
**
**      A valid Modula-2 program is read from the input and
**      a formatted program is written to the output.
**      It is basically a recursive descent parser with actions
**      intermixed with syntax scanning.
**
**      The actions of the program are as follows:
**
**      FORMATTING:  Each structured statement is formatted
**      in the following pattern (with indentation "indent"):
**
**                XXXXXX header XXXXXXXX
**                        XXXXXXXXXXXXXXXXXX
**                        XXXXX body XXXXXX
**                        XXXXXXXXXXXXXXXXXX
**                END
**
**      where the header is one of:
**
**                IF <expression> THEN
**                ELSIF <expression> THEN
**                ELSE
**                WHILE <expression> DO
**                FOR <control variable> := <FOR list> DO
**                WITH <RECORD variable> DO
**                REPEAT
**                LOOP
**                CASE <expression> OF
**                <CASE label list>:
**
**      and the last line begins with UNTIL or is END.
**      Other program parts are formatted similarly.  The headers are:
**
**                <MODULE/PROCEDURE heading>;
**                CONST
**                TYPE
**                VAR
**                BEGIN
**                (various FOR records AND RECORD variants)
**
**      COMMENTS:  Each comment that starts before or on a specified
**      column on an input line (program constant "commthresh") is
**      copied without shifting or reformatting.  Each comment that
**      starts after "commthresh" is reformatted and left-justified
**      following the aligned comment base column ("alcommbase").
**
**      SPACES AND BLANK LINES:  Spaces not at line breaks are copied from
**      the input.  Blank lines are copied from the input if they appear
**      between statements (or appropriate declaration units).  A blank
**      line is inserted above each significant part of each program/
**      procedure if one is not already there.
**
**      CONTINUATION:  Lines that are too long for an output line are
**      continued with additional indentation ("contindent").
*)

CONST
    TAB = 11C;
    NEWLINE = 12C;                  (* for Unix *)
    FF = 14C;
    maxrwlen = 15;                  (* size of reserved word strings *)
    ordminchar = 0;                 (* ord of lowest char in char set *)
    ordmaxchar = 127;               (* ord of highest char in char set *)
(* The following parameters may be adjusted for the installation: *)
    maxinlen = 255;                 (* maximum width of input line + 1 *)
    maxoutlen = 128;                (* maximum width of output line *)
    tabinterval = 8;                (* interval between tab columns *)
    initmargin = 0;                 (* initial value of output margin *)
    commthresh = tabinterval;       (* column threshhold in input for comments to be aligned *)
    alcommbase = 40;                (* aligned comments in output start after this column *)
    indent = tabinterval;           (* RECOMMENDED indentation increment *)
    contindent = tabinterval;       (* continuation indentation, >indent *)
    commindent = tabinterval;       (* comment continuation indentation *)

TYPE
    natural = [-1..1000000];        (* kludge because compiler doesn't *)
    inrange = [-1..maxinlen];       (* recognize qualified subranges *)
    outrange = [-1..maxoutlen];

    errortype = (longline, noendcomm, notquote, longword, notdo, notof, notend, notthen, notbegin, notuntil, notident,
    notsemicolon, notcolon, notperiod, notparen, noeof);

    chartype = (illegal, special, chapostrophe, chleftparen, chrightparen, chperiod, digit, chcolon, chsemicolon,
    chlessthan, chgreaterthan, letter, chleftbrace, chbar);

    chartypeset = SET OF chartype;  (* for reserved word recognition *)

    resword = (                     (* reserved words ordered by length *)
    rwif, rwdo, rwof, rwto, rwin, rwor,
                    (* length: 2 *)
    rwend, rwfor, rwvar, rwdiv, rwmod, rwset, rwand, rwnot, rwnil,
                    (* length: 3 *)
    rwthen, rwelse, rwwith, rwcase, rwtype, rwloop, rwfrom,
                    (* length: 4 *)
    rwbegin, rwelsif, rwuntil, rwwhile, rwarray, rwconst,
                    (* length: 5 *)
    rwrepeat, rwrecord, rwmodule, rwimport, rwexport,
                    (* length: 6 *)
    rwpointer,                      (* length: 7 *)
    rwprocedure, rwqualified,       (* length: 9 *)
    rwdefinition,                   (* length: 10 *)
    rwimplementation,               (* length: 14 *)
    rwx);                           (* length: 15 for table sentinel *)
    rwstring =  ARRAY [1..maxrwlen] OF CHAR;

    firstclass = (                  (* class of word if on new line *)
    newclause,                      (* start of new clause *)
    continue,                       (* continuation of clause *)
    alcomm,                         (* start of aligned comment *)
    contalcomm,                     (* continuation of aligned comment *)
    uncomm,                         (* start of unaligned comment *)
    contuncomm);                    (* continuation of unaligned comment *)

    wordtype = RECORD               (* data record for word *)
        whenfirst : firstclass; (* class of word if on new line *)
        puncfollows : BOOLEAN;  (* to reduce dangling punctuation *)
        blanklncount : natural; (* number of preceding blank lines *)
        spaces : INTEGER;       (* number of spaces preceding word *)
        base : [-1..maxinlen];  (* inline.buf[base] precedes word *)
        size : inrange;
    END;                            (* length of word in inline.buf *)

    symboltype = (                  (* symbols for syntax analysis *)
    symodule, sydefinition, syimplementation, syfrom, syimport, syexport, syqual, syproc, declarator, sybegin, syend, syif,
    sythen, syelsif, syelse, syloop, sycase, syof, syuntil, syrepeat, forwhilewith, sydo, syrecord, ident, intconst,
    semicolon, leftparen, rightparen, period, colon, bar, othersym, otherword, comment, syeof);
    symbolset = SET OF symboltype;

VAR
    inline : RECORD                 (* input line data *)
        endoffile : BOOLEAN;    (* end of file on input? *)
        ch : CHAR;              (* current char, buf[index] *)
        index : inrange;        (* subscript of current char *)
        len : natural;          (* length of input line in buf *)
        buf : ARRAY [1..maxinlen] OF CHAR;
    END;
    outline : RECORD                (* output line data *)
        blanklns : natural;     (* number of preceding blank lines *)
        len : outrange;         (* number of chars in buf *)
        buf : ARRAY [1..maxoutlen] OF CHAR;
    END;
    curword : wordtype;             (* current word *)
    margin : outrange;              (* left margin *)
    lnpending : BOOLEAN;            (* new line before next symbol? *)
    inheader : BOOLEAN;             (* are we scanning a proc header? *)
    symbol : symboltype;            (* current symbol *)

  (* Structured Constants *)
    headersyms : symbolset;         (* headers for program parts *)
    strucsyms : symbolset;          (* symbols that begin structured statements *)
    stmtbeginsyms : symbolset;      (* symbols that begin statements *)
    stmtendsyms : symbolset;        (* symbols that follow statements *)
    stopsyms : symbolset;           (* symbols that stop expression scan *)
    recendsyms : symbolset;         (* symbols that stop record scan *)
    datawords : symbolset;          (* to reduce dangling punctuation *)
    firstrw : ARRAY [1..maxrwlen] OF resword;
    rwword : ARRAY [rwif..rwimplementation] OF rwstring;
    rwsy : ARRAY [rwif..rwimplementation] OF symboltype;
    charclass : ARRAY CHAR OF chartype;
    symbolclass : ARRAY chartype OF symboltype;

PROCEDURE StructConsts;
(* establish values of structured constants *)
VAR
    i : [ordminchar..ordmaxchar];   (* loop index *)
    ch : CHAR;                      (* loop index *)

PROCEDURE BuildResWord(rw : resword; symword : rwstring; symbol : symboltype);
BEGIN
    rwword[rw] := symword;          (* reserved word string *)
    rwsy[rw] := symbol;             (* map to symbol *)
END BuildResWord;

BEGIN                                   (* StructConsts *)
(* symbol sets for syntax analysis *)
    headersyms := symbolset{symodule, syproc, declarator, sybegin, syend, syeof};
    strucsyms := symbolset{sycase, syrepeat, syif, forwhilewith, syloop};
    stmtbeginsyms := strucsyms + symbolset{ident};
    stmtendsyms := symbolset{semicolon, bar, syend, syuntil, syelsif, syelse, syeof};
    stopsyms := headersyms + strucsyms + stmtendsyms;
    recendsyms := symbolset{rightparen, syend, syeof};
    datawords := symbolset{otherword, intconst, ident, syend};

(* constants for recognizing reserved words *)
    firstrw[1] := rwif;             (* length: 1 *)
    firstrw[2] := rwif;             (* length: 2 *)
    BuildResWord(rwif, 'IF             ', syif);
    BuildResWord(rwdo, 'DO             ', sydo);
    BuildResWord(rwof, 'OF             ', syof);
    BuildResWord(rwto, 'TO             ', othersym);
    BuildResWord(rwin, 'IN             ', othersym);
    BuildResWord(rwor, 'OR             ', othersym);
    firstrw[3] := rwend;            (* length: 3 *)
    BuildResWord(rwend, 'END            ', syend);
    BuildResWord(rwfor, 'FOR            ', forwhilewith);
    BuildResWord(rwvar, 'VAR            ', declarator);
    BuildResWord(rwdiv, 'DIV            ', othersym);
    BuildResWord(rwmod, 'MOD            ', othersym);
    BuildResWord(rwset, 'SET            ', othersym);
    BuildResWord(rwand, 'AND            ', othersym);
    BuildResWord(rwnot, 'NOT            ', othersym);
    BuildResWord(rwnil, 'NIL            ', otherword);
    firstrw[4] := rwthen;           (* length: 4 *)
    BuildResWord(rwthen, 'THEN           ', sythen);
    BuildResWord(rwelse, 'ELSE           ', syelse);
    BuildResWord(rwwith, 'WITH           ', forwhilewith);
    BuildResWord(rwloop, 'LOOP           ', syloop);
    BuildResWord(rwfrom, 'FROM           ', syfrom);
    BuildResWord(rwcase, 'CASE           ', sycase);
    BuildResWord(rwtype, 'TYPE           ', declarator);
    firstrw[5] := rwbegin;          (* length: 5 *)
    BuildResWord(rwbegin, 'BEGIN          ', sybegin);
    BuildResWord(rwelsif, 'ELSIF          ', syelsif);
    BuildResWord(rwuntil, 'UNTIL          ', syuntil);
    BuildResWord(rwwhile, 'WHILE          ', forwhilewith);
    BuildResWord(rwarray, 'ARRAY          ', othersym);
    BuildResWord(rwconst, 'CONST          ', declarator);
    firstrw[6] := rwrepeat;         (* length: 6 *)
    BuildResWord(rwrepeat, 'REPEAT         ', syrepeat);
    BuildResWord(rwrecord, 'RECORD         ', syrecord);
    BuildResWord(rwmodule, 'MODULE         ', symodule);
    BuildResWord(rwimport, 'IMPORT         ', syimport);
    BuildResWord(rwexport, 'EXPORT         ', syexport);
    firstrw[7] := rwpointer;        (* length: 7 *)
    BuildResWord(rwpointer, 'POINTER        ', othersym);
    firstrw[8] := rwprocedure;      (* length: 8 *)
    firstrw[9] := rwprocedure;      (* length: 9 *)
    BuildResWord(rwprocedure, 'PROCEDURE      ', syproc);
    BuildResWord(rwqualified, 'QUALIFIED      ', syqual);
    firstrw[10] := rwdefinition;    (* length: 10 *)
    BuildResWord(rwdefinition, 'DEFINITION     ', sydefinition);
    firstrw[11] := rwimplementation;(* length: 11 *)
    firstrw[12] := rwimplementation;(* length: 12 *)
    firstrw[13] := rwimplementation;(* length: 13 *)
    firstrw[14] := rwimplementation;(* length: 14 *)
    BuildResWord(rwimplementation, 'IMPLEMENTATION ', syimplementation);
    firstrw[15] := rwx;             (* length: 15 FOR table sentinel *)

(* constants for lexical scan *)
    FOR i := ordminchar TO ordmaxchar DO
        charclass[CHR(i)] := illegal;
    END;
    FOR ch := 'a' TO 'z' DO
        charclass[ch] := letter;
        charclass[CAP(ch)] := letter;
    END;
    FOR ch := '0' TO '9' DO
        charclass[ch] := digit;
    END;
    charclass[' '] := special;
    charclass['"'] := chapostrophe;
    charclass['#'] := special;
    charclass['&'] := special;
    charclass["'"] := chapostrophe;
    charclass['('] := chleftparen;
    charclass[')'] := chrightparen;
    charclass['*'] := special;
    charclass['+'] := special;
    charclass[','] := special;
    charclass['-'] := special;
    charclass['.'] := chperiod;
    charclass['/'] := special;
    charclass[':'] := chcolon;
    charclass[';'] := chsemicolon;
    charclass['<'] := chlessthan;
    charclass['='] := special;
    charclass['>'] := chgreaterthan;
    charclass['@'] := special;
    charclass['['] := special;
    charclass[']'] := special;
    charclass['^'] := special;
    charclass['{'] := special;
    charclass['|'] := chbar;
    charclass['}'] := special;
    symbolclass[illegal] := othersym;
    symbolclass[special] := othersym;
    symbolclass[chapostrophe] := otherword;
    symbolclass[chleftparen] := leftparen;
    symbolclass[chrightparen] := rightparen;
    symbolclass[chperiod] := period;
    symbolclass[digit] := intconst;
    symbolclass[chcolon] := colon;
    symbolclass[chsemicolon] := semicolon;
    symbolclass[chlessthan] := othersym;
    symbolclass[chgreaterthan] := othersym;
    symbolclass[chbar] := bar;
    symbolclass[letter] := ident;
END StructConsts;

(* FlushLine/WriteError/ReadLine convert between files and lines. *)

PROCEDURE FlushLine;
(* Write buffer into output file *)
VAR
    i, j, vircol : outrange;        (* loop index *)
    nonblankseen : BOOLEAN;
BEGIN
    WITH outline DO
        WHILE blanklns > 0 DO
            WriteLn;
            blanklns := blanklns - 1;
        END;
        IF len > 0 THEN
            vircol := 0;
            nonblankseen := FALSE;
                    (* set this to TRUE if you don't want blanks to tab conversion *)
            FOR i := 0 TO len - 1 DO
                IF buf[i+1] <> ' ' THEN
                    IF NOT nonblankseen THEN
                        LOOP
                            j := (vircol DIV tabinterval + 1) * tabinterval;
                            IF j > i THEN
                                EXIT;
                            END;
                            Write(TAB);
                            vircol := j;
                        END;
                    END;
                    nonblankseen := TRUE;
                    WHILE vircol < i DO
                        Write(' ');
                        vircol := vircol + 1;
                    END;
                    Write(buf[i+1]);
                    vircol := i + 1;
                END;
            END;
            WriteLn;
            len := 0;
        END;
    END;
END FlushLine;

PROCEDURE WriteError(error : errortype);
(* report error to output *)
VAR
    i, ix : inrange;                (* loop index, limit *)
BEGIN
    FlushLine;
    WriteString('(* !!! error, ');
    CASE error OF
    longline:
        WriteString('shorter line');
    | noendcomm:
        WriteString('END OF comment');
    | notquote:
        WriteString("final ' on line");
    | longword:
        WriteString('shorter word');
    | notdo:
        WriteString('"DO"');
    | notof:
        WriteString('"OF"');
    | notend:
        WriteString('"END"');
    | notthen:
        WriteString('"THEN"');
    | notbegin:
        WriteString('"BEGIN"');
    | notuntil:
        WriteString('"UNTIL"');
    | notident:
        WriteString('"identifier"');
    | notsemicolon:
        WriteString('";"');
    | notperiod:
        WriteString('"."');
    | notcolon:
        WriteString('":"');
    | notparen:
        WriteString('")"');
    | noeof:
        WriteString('END OF file');
    END;
    WriteString(' expected');
    IF error >= longword THEN
        WriteString(', NOT "');
        WITH inline DO
            WITH curword DO
                IF size > maxrwlen THEN
                    ix := maxrwlen
                ELSE
                    ix := size;
                END;
                FOR i := 1 TO ix DO
                    Write(buf[base + i]);
                END;
            END;
        END;
        Write('"');
    END;
    IF error = noeof THEN
        WriteString(', FORMATTING STOPS');
    END;
    WriteString(' !!! *)');
    WriteLn;
END WriteError;

PROCEDURE ReadLine;
(* Read line into input buffer *)
VAR
    c : CHAR;                       (* input character *)
    nonblank : BOOLEAN;             (* is char other than space? *)
    i : INTEGER;
BEGIN
    WITH inline DO
        len := 0;
        LOOP
            Read(c);
            IF Done THEN
                endoffile := Done;
                EXIT;
            END;
            IF c = NEWLINE THEN
                EXIT;
            END;
            IF c < ' ' THEN (* convert ISO control chars (except leading form feed) to spaces *)
                IF c = TAB THEN
                    (* ISO TAB char *)
                    c := ' ';
                    (* add last space at end *)
                    WHILE len MOD 8 <> 7 DO
                        len := len + 1;
                        IF len < maxinlen THEN
                            buf[len] := c;
                        END;
                    END;
                    (* END tab handling *)
                ELSIF (c <> FF) OR (len > 0) THEN
                    c := ' ';
                END;
            END;            (* END ISO control char conversion *)
            len := len + 1;
            IF len < maxinlen THEN
                buf[len] := c;
            END;
        END;
        IF NOT endoffile THEN
            IF len >= maxinlen THEN
                    (* input line too long *)
                WriteError(longline);
                len := maxinlen - 1;
            END;
            WHILE (len > 0) AND (buf[len] = ' ') DO
                len := len - 1;
            END;
        END;
        len := len + 1;         (* add exactly ONE trailing blank *)
        buf[len] := ' ';
        index := 0;
    END;
END ReadLine;

PROCEDURE GetChar;
(* get next char from input buffer *)
BEGIN
    WITH inline DO
        index := index + 1;
        ch := buf[index];
    END;
END GetChar;

PROCEDURE NextChar() : CHAR;
(* look at next char in input buffer *)
BEGIN
    RETURN inline.buf[inline.index + 1];
END NextChar;

PROCEDURE StartWord(startclass : firstclass);
(* note beginning of word, and count preceding lines and spaces *)
VAR
    first : BOOLEAN;                (* is word the first on input line? *)
BEGIN
    first := FALSE;
    WITH inline DO
        WITH curword DO
            whenfirst := startclass;
            blanklncount := 0;
            WHILE (index >= len) AND NOT endoffile DO
                IF len = 1 THEN
                    blanklncount := blanklncount + 1;
                END;
                IF startclass = contuncomm THEN
                    FlushLine
                ELSE
                    first := TRUE;
                END;
                ReadLine;
                    (* with exactly ONE trailing blank *)
                GetChar;
                IF ch = FF THEN
                    FlushLine;
                    Write(FF);
                    blanklncount := 0;
                    GetChar;
                END;
            END;
            spaces := 0;    (* count leading spaces *)
            IF NOT endoffile THEN
                WHILE ch = ' ' DO
                    spaces := spaces + 1;
                    GetChar;
                END;
            END;
            IF first THEN
                spaces := 1;
            END;
            base := index - 1;
        END;
    END;
END StartWord;

PROCEDURE FinishWord;
(* note end of word *)
BEGIN
    WITH inline DO
        WITH curword DO
            puncfollows := (symbol IN datawords) AND (ch <> ' ');
            size := index - base - 1;
        END;
    END;
END FinishWord;

PROCEDURE CopyWord(newline : BOOLEAN; pword : wordtype);
(* copy word from input buffer into output buffer *)
VAR
    i : INTEGER;                    (* outline.len excess, loop index *)
BEGIN
    WITH pword DO
        WITH outline DO
            i := maxoutlen - len - spaces - size;
            IF newline OR (i < 0) OR ((i = 0) AND puncfollows) THEN
                FlushLine;
            END;
            IF len = 0 THEN (* first word on output line *)
                blanklns := blanklncount;
                CASE whenfirst OF
                    (* update LOCAL word.spaces *)
                newclause:
                    spaces := margin;
                | continue:
                    spaces := margin;
                | alcomm:
                    spaces := alcommbase;
                | contalcomm:
                    spaces := alcommbase + commindent;
                | uncomm:
                    spaces := base;
                | contuncomm:
                    (* spaces := spaces *);
                END;
                IF spaces + size > maxoutlen THEN
                    spaces := maxoutlen - size;
                    (* reduce spaces *)
                    IF spaces < 0 THEN
                        WriteError(longword);
                        size := maxoutlen;
                        spaces := 0;
                    END;
                END;
            END;
            FOR i := 1 TO spaces DO
                    (* put out spaces *)
                len := len + 1;
                buf[len] := ' ';
            END;
            FOR i := 1 TO size DO
                    (* copy actual word *)
                len := len + 1;
                buf[len] := inline.buf[base + i];
            END;
        END;
    END;
END CopyWord;

PROCEDURE DoComment;                    (* copy aligned or unaligned comment *)

PROCEDURE CopyComment(commclass : firstclass; commbase : inrange);
(* copy words of comment *)
VAR
    endcomment : BOOLEAN;           (* end of comment? *)
BEGIN
    WITH curword DO                 (* copy comment begin symbol *)
        whenfirst := commclass;
        spaces := commbase - outline.len;
        CopyWord((spaces < 0) OR (blanklncount > 0), curword);
    END;
    commclass := VAL(firstclass, ORD(commclass)+1);
    WITH inline DO
        REPEAT                  (* loop for successive words *)
            StartWord(commclass);
            endcomment := endoffile;
                    (* premature end? *)
            IF endcomment THEN
                WriteError(noendcomm)
            ELSE
                REPEAT
                    IF ch = '*' THEN
                        GetChar;
                        IF ch = ')' THEN
                            endcomment := TRUE;
                            GetChar;
                        END;
                    ELSE
                        GetChar;
                    END;
                UNTIL (ch = ' ') OR endcomment;
            END;
            FinishWord;
            CopyWord(FALSE, curword)
        UNTIL endcomment;
    END;
END CopyComment;

BEGIN                                   (* DoComment *)
    IF curword.base < commthresh THEN
                    (* copy comment without alignment *)
        CopyComment(uncomm, curword.base)
    ELSE                            (* align AND format comment *)
        CopyComment(alcomm, alcommbase);
    END;
END DoComment;

PROCEDURE GetSymbol;
(* get next non-comment symbol *)

PROCEDURE CopySymbol(symbol : symboltype; pword : wordtype);
(* copy word(s) of symbol *)
BEGIN
    IF symbol = comment THEN
        DoComment;              (* NOTE: DoComment uses global word! *)
        lnpending := TRUE;
    ELSIF symbol = semicolon THEN
        CopyWord(FALSE, pword);
        lnpending := NOT inheader;
    ELSE
        CopyWord(lnpending, pword);
        lnpending := FALSE;
    END;
END CopySymbol;

PROCEDURE FindSymbol;
(* find next symbol in input buffer *)

VAR
    termch : CHAR;                  (* string terminator *)
    chclass : chartype;             (* classification of leading char *)

PROCEDURE CheckResWord;
(* check if current identifier is reserved word/symbol *)
VAR
    rw, rwbeyond : resword;         (* loop index, limit *)
    symword : rwstring;             (* copy of symbol word *)
    i : [-1..maxrwlen];             (* loop index *)
BEGIN
    WITH curword DO
        WITH inline DO
            size := index - base - 1;
            IF size < maxrwlen THEN
                symword := '               ';
                FOR i := 1 TO size DO
                    symword[i] := CAP(buf[ base + i]);
                END;
                rw := firstrw[size];
                rwbeyond := firstrw[size + 1];
                symbol := semicolon;
                REPEAT
                    IF rw >= rwbeyond THEN
                        symbol := ident
                    ELSIF symword = rwword[rw] THEN
                        symbol := rwsy[rw]
                    ELSE
                        rw := VAL(resword,ORD(rw)+1);
                    END;
                UNTIL symbol <> semicolon;
            END;
            whenfirst := newclause;
        END;
    END;
END CheckResWord;

PROCEDURE GetName;
BEGIN
    WHILE charclass[inline.ch] IN chartypeset{letter, digit} DO
        GetChar;
    END;
    CheckResWord;
END GetName;

PROCEDURE GetNumber;
BEGIN
    WITH inline DO
        WHILE charclass[ch] = digit DO
            GetChar;
        END;
        IF ch = '.' THEN
            IF charclass[NextChar()] = digit THEN
                    (* NOTE: NextChar is a function! *)
                symbol := otherword;
                GetChar;
                WHILE charclass[ch] = digit DO
                    GetChar;
                END;
            END;
        END;
        IF CAP(ch) = 'E' THEN
            symbol := otherword;
            GetChar;
            IF (ch = '+') OR (ch = '-') THEN
                GetChar;
            END;
            WHILE charclass[ch] = digit DO
                GetChar;
            END;
        END;
    END;
END GetNumber;

PROCEDURE GetStringLiteral;
VAR
    endstring : BOOLEAN;            (* end of string literal? *)
BEGIN
    WITH inline DO
        endstring := FALSE;
        REPEAT
            GetChar;
            IF ch = termch THEN
                endstring := TRUE;
            ELSIF index >= len THEN
                    (* error, final "'" not on line *)
                WriteError(notquote);
                symbol := syeof;
                endstring := TRUE;
            END;
        UNTIL endstring;
        GetChar;
    END;
END GetStringLiteral;

BEGIN                                   (* FindSymbol *)
    StartWord(continue);
    WITH inline DO
        IF endoffile THEN
            symbol := syeof
        ELSE
            termch := ch;   (* save for string literal routine *)
            chclass := charclass[ch];
            symbol := symbolclass[chclass];
            GetChar;        (* second CHAR *)
            CASE chclass OF
            chsemicolon, chrightparen, chleftbrace, special, illegal: ;
            | letter:
                GetName;
            | digit:
                GetNumber;
            | chapostrophe:
                GetStringLiteral;
            | chcolon:
                IF ch = '=' THEN
                    symbol := othersym;
                    GetChar;
                END;
            | chlessthan:
                IF (ch = '=') OR (ch = '>') THEN
                    GetChar;
                END;
            | chgreaterthan:
                IF ch = '=' THEN
                    GetChar;
                END;
            | chleftparen:
                IF ch = '*' THEN
                    symbol := comment;
                    GetChar;
                END;
            | chperiod:
                IF ch = '.' THEN
                    symbol := colon;
                    GetChar;
                END;
            END;
            FinishWord;
        END;
    END;                            (* FindSymbol *)
END FindSymbol;

BEGIN                                   (* GetSymbol *)
    REPEAT
        CopySymbol(symbol, curword);
                    (* copy word for symbol to output *)
        FindSymbol              (* get next symbol *)
    UNTIL symbol <> comment;
END GetSymbol;

PROCEDURE StartClause;
(* (this may be a simple clause, or the start of a header) *)
BEGIN
    curword.whenfirst := newclause;
    lnpending := TRUE;
END StartClause;

PROCEDURE PassSemicolons;
(* pass consecutive semicolons *)
BEGIN
    WHILE symbol = semicolon DO
        GetSymbol;
        StartClause;
    END;
END PassSemicolons;

PROCEDURE StartPart;
(* start program part *)
BEGIN
    WITH curword DO
        IF blanklncount = 0 THEN
            blanklncount := 1;
        END;
    END;
END StartPart;

PROCEDURE StartBody;
(* finish header, start body of structure *)
BEGIN
    StartClause;
    margin := margin + indent;
END StartBody;

PROCEDURE FinishBody;
(* retract margin *)
BEGIN
    margin := margin - indent;
END FinishBody;

PROCEDURE PassPhrase(finalsymbol : symboltype);
(* process symbols until significant symbol encountered *)
VAR
    endsyms : symbolset;            (* complete set of stopping symbols *)
BEGIN
    IF symbol <> syeof THEN
        endsyms := stopsyms;
        INCL(endsyms, finalsymbol);
        REPEAT
            GetSymbol
        UNTIL symbol IN endsyms;
    END;
END PassPhrase;

PROCEDURE Expect(expectedsym : symboltype; error : errortype; syms : symbolset);
(* fail if current symbol is not the expected one, then recover *)
BEGIN
    IF symbol = expectedsym THEN
        GetSymbol
    ELSE
        WriteError(error);
        INCL(syms, expectedsym);
        WHILE NOT (symbol IN syms) DO
            GetSymbol;
        END;
        IF symbol = expectedsym THEN
            GetSymbol;
        END;
    END;
END Expect;

PROCEDURE Heading;
(* process heading for program or procedure *)

PROCEDURE MatchParens;                  (* process parentheses in heading *)
VAR
    endsyms : symbolset;
BEGIN
    GetSymbol;
    WHILE NOT (symbol IN recendsyms) DO
        IF symbol = leftparen THEN
            MatchParens
        ELSE
            GetSymbol;
        END;
    END;
    endsyms := stopsyms + recendsyms;
    Expect(rightparen, notparen, endsyms);
END MatchParens;

BEGIN                                   (* heading *)
    GetSymbol;
    PassPhrase(leftparen);
    IF symbol = leftparen THEN
        inheader := TRUE;
        MatchParens;
        inheader := FALSE;
    END;
    IF symbol = colon THEN
        PassPhrase(semicolon);
    END;
    Expect(semicolon, notsemicolon, stopsyms);

END Heading;

PROCEDURE DoRecord;
(* process record declaration *)
BEGIN
    GetSymbol;
    StartBody;
    PassFields(FALSE);
    FinishBody;
    Expect(syend, notend, recendsyms);
END DoRecord;

PROCEDURE DoVariant;
(* process (case) variant part *)
BEGIN
    PassPhrase(syof);
    Expect(syof, notof, stopsyms);
    StartBody;
    PassFields(TRUE);
    FinishBody;
END DoVariant;

PROCEDURE DoParens(forvariant : BOOLEAN);
(* process parentheses in record *)
BEGIN
    GetSymbol;
    IF forvariant THEN
        StartBody;
    END;
    PassFields(FALSE);
    lnpending := FALSE;             (* for empty field list *)
    Expect(rightparen, notparen, recendsyms);
    IF forvariant THEN
        FinishBody;
    END;
END DoParens;

PROCEDURE PassFields(forvariant : BOOLEAN);
(* process declarations *)
BEGIN
    WHILE NOT (symbol IN recendsyms) DO
        IF symbol = semicolon THEN
            PassSemicolons
        ELSIF symbol = syrecord THEN
            DoRecord
        ELSIF symbol = sycase THEN
            DoVariant
        ELSIF symbol = leftparen THEN
            DoParens(forvariant)
        ELSE
            GetSymbol;
        END;
    END;
END PassFields;

PROCEDURE Statement;
(* process statement *)
BEGIN
    CASE symbol OF
    sycase:
        CaseStatement;
        Expect(syend, notend, stmtendsyms);
    | syif:
        IfStatement;
        Expect(syend, notend, stmtendsyms);
    | syloop:
        LoopStatement;
        Expect(syend, notend, stmtendsyms);
    | syrepeat:
        RepeatStatement;
    | forwhilewith:
        ForWhileWithStatement;
        Expect(syend, notend, stmtendsyms);
    | ident:
        AssignmentProccall;
    | semicolon: ;
    END;
END Statement;

PROCEDURE AssignmentProccall;
(* pass an assignment statement or procedure call *)
BEGIN
    WHILE NOT (symbol IN stmtendsyms) DO
        GetSymbol;
    END;
END AssignmentProccall;

PROCEDURE StatementSequence;
(* process sequence of statements *)
BEGIN
    Statement;
    LOOP
        IF symbol <> semicolon THEN
            EXIT;
        END;
        GetSymbol;
        Statement;
    END;
END StatementSequence;

PROCEDURE IfStatement;
(* process if statement *)
BEGIN
    PassPhrase(sythen);
    Expect(sythen, notthen, stopsyms);
    StartBody;
    StatementSequence;
    FinishBody;
    WHILE symbol = syelsif DO
        StartClause;
        PassPhrase(sythen);
        Expect(sythen, notthen, stopsyms);
        StartBody;              (* new line after 'THEN' *)
        StatementSequence;
        FinishBody;
    END;
    IF symbol = syelse THEN
        StartClause;
        GetSymbol;
        StartBody;              (* new line after 'ELSE' *)
        StatementSequence;
        FinishBody;
    END;
END IfStatement;

PROCEDURE CaseStatement;
(* process case statement *)
BEGIN
    PassPhrase(syof);
    Expect(syof, notof, stopsyms);
    StartClause;
    OneCase;
    WHILE symbol = bar DO
        GetSymbol;
        OneCase;
    END;
    IF symbol = syelse THEN
        GetSymbol;
        StartBody;
        StatementSequence;
        FinishBody;
    END;
END CaseStatement;

PROCEDURE OneCase;
(* process one case clause *)
BEGIN
    IF NOT (symbol IN symbolset{bar, syelse}) THEN
        PassPhrase(colon);
        Expect(colon, notcolon, stopsyms);
        StartBody;              (* new line, indent after colon *)
        StatementSequence;
        FinishBody;             (* left-indent after case *)
    END;
END OneCase;

PROCEDURE RepeatStatement;
(* process repeat statement *)
BEGIN
    GetSymbol;
    StartBody;                      (* new line, indent after 'REPEAT' *)
    StatementSequence;
    FinishBody;                     (* left-ident after UNTIL *)
    StartClause;                    (* new line before UNTIL *)
    Expect(syuntil, notuntil, stmtendsyms);
    PassPhrase(semicolon);
END RepeatStatement;

PROCEDURE LoopStatement;
(* process loop statement *)
BEGIN
    GetSymbol;
    StartBody;                      (* new line, indent after LOOP *)
    StatementSequence;
    FinishBody;                     (* left-ident before END *)
END LoopStatement;

PROCEDURE ForWhileWithStatement;
(* process for, while, or with statement *)
BEGIN
    PassPhrase(sydo);
    Expect(sydo, notdo, stopsyms);
    StartBody;
    StatementSequence;
    FinishBody;
END ForWhileWithStatement;

PROCEDURE ProcedureDeclaration;
(* pass a procedure declaration *)
BEGIN
    ProcedureHeading;
    Block;
    Expect(ident, notident, stmtendsyms);
    Expect(semicolon, notsemicolon, stmtendsyms);
END ProcedureDeclaration;

PROCEDURE ProcedureHeading;
BEGIN
    StartClause;
    Heading;
END ProcedureHeading;

PROCEDURE Block;
BEGIN
    WHILE symbol IN symbolset{declarator, symodule, syproc} DO
        Declaration;
    END;
    IF symbol = sybegin THEN
        GetSymbol;
        StartBody;
        StatementSequence;
        FinishBody;
    END;
    Expect(syend, notend, stmtendsyms);
END Block;

PROCEDURE Declaration;
BEGIN
    IF symbol = declarator THEN
        StartClause;            (* CONST, TYPE, VAR *)
        GetSymbol;
        StartBody;
        REPEAT
            PassPhrase(syrecord);
            IF symbol = syrecord THEN
                DoRecord;
            END;
            IF symbol = semicolon THEN
                PassSemicolons;
            END;
        UNTIL symbol IN headersyms;
        FinishBody;
    ELSIF symbol = symodule THEN
        ModuleDeclaration;
    ELSIF symbol = syproc THEN
        ProcedureDeclaration;
    END;
END Declaration;

PROCEDURE ModuleDeclaration;
BEGIN
    PassPhrase(semicolon);
    PassSemicolons;
    WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
        ImportExport;
    END;
    Block;
    Expect(ident, notident, stmtendsyms);
END ModuleDeclaration;

PROCEDURE ImportExport;
BEGIN
    IF symbol = syfrom THEN
        PassPhrase(syimport);
    END;
    IF symbol = syimport THEN
        GetSymbol;
    ELSIF symbol = syexport THEN
        GetSymbol;
        IF symbol = syqual THEN
            GetSymbol;
        END;
    END;
    StartBody;
    PassPhrase(semicolon);
    FinishBody;
    GetSymbol;
END ImportExport;

PROCEDURE OneDefinition;
BEGIN
    IF symbol = declarator THEN
        Declaration;
    ELSIF symbol = syproc THEN
        ProcedureHeading;
    END;
END OneDefinition;

PROCEDURE DefinitionModule;
BEGIN
    GetSymbol;
    PassPhrase(semicolon);
    GetSymbol;
    WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
        ImportExport;
    END;
    WHILE symbol IN symbolset{declarator, syproc} DO
        OneDefinition;
    END;
    Expect(syend, notend, stmtendsyms);
    GetSymbol;
    Expect(period, notperiod, stmtendsyms);
END DefinitionModule;

PROCEDURE ProgramModule;
BEGIN
    ModuleDeclaration;
    Expect(period, notperiod, stmtendsyms);
END ProgramModule;

PROCEDURE CompilationUnit;
BEGIN
    IF symbol = syimplementation THEN
        GetSymbol;
        ProgramModule;
    ELSIF symbol = sydefinition THEN
        DefinitionModule;
    ELSE
        ProgramModule;
    END;
END CompilationUnit;

PROCEDURE CopyRemainder;
(* copy remainder of input *)
BEGIN
    WriteError(noeof);
    WITH inline DO
        REPEAT
            CopyWord(FALSE, curword);
            StartWord(contuncomm);
            IF NOT endoffile THEN
                REPEAT
                    GetChar
                UNTIL ch = ' ';
            END;
            FinishWord;
        UNTIL endoffile;
    END;
END CopyRemainder;

PROCEDURE Initialize;
(* initialize global variables *)
BEGIN
    WITH inline DO
        endoffile := FALSE;
        ch := ' ';
        index := 0;
        len := 0;
    END;
    WITH outline DO
        blanklns := 0;
        len := 0;
    END;
    WITH curword DO
        whenfirst := contuncomm;
        puncfollows := FALSE;
        blanklncount := 0;
        spaces := 0;
        base := 0;
        size := 0;
    END;
    margin := initmargin;
    lnpending := FALSE;
    symbol := othersym;
END Initialize;

BEGIN
    StructConsts;
    Initialize;
(* Files may be opened here. *)
    GetSymbol;
    CompilationUnit;
    IF NOT inline.endoffile THEN
        CopyRemainder;
    END;
    FlushLine;
END Modula2PrettyPrinter.
SHAR_EOF
if test 33277 -ne "`wc -c 'm2p.mod'`"
then
    echo shar: error transmitting "'m2p.mod'" '(should have been 33277 characters)'
fi
if test -f 'InOut.def'
then
    echo shar: over-writing existing file "'InOut.def'"
fi
cat << \SHAR_EOF > 'InOut.def'
DEFINITION MODULE InOut;
EXPORT
    Done, Read, Write, WriteLn, WriteString;

VAR
    Done        : BOOLEAN;

PROCEDURE Read(VAR ch : CHAR);

PROCEDURE Write(ch : CHAR);

PROCEDURE WriteLn;

PROCEDURE WriteString(s : ARRAY OF CHAR);

END InOut.
SHAR_EOF
if test 233 -ne "`wc -c 'InOut.def'`"
then
    echo shar: error transmitting "'InOut.def'" '(should have been 233 characters)'
fi
if test -f 'InOut.c'
then
    echo shar: over-writing existing file "'InOut.c'"
fi
cat << \SHAR_EOF > 'InOut.c'
#include    <stdio.h>

int InOut_Done    = 0;

InOut__init()
{
    InOut_Done = 0;
}

InOut_Read(c)
    char    *c;
{
    register char    ch;

    if ((ch = getchar()) == EOF)
        InOut_Done = 1;
    else
        *c = ch & 0177;
}

InOut_Write(c)
    char    c;
{
    putchar(c);
}

InOut_WriteLn()
{
    putchar('\n');
}

InOut_WriteString(s, l)
    char    *s;
    int    l;
{
    while (l-- > 0)
        putchar(*s++);
}
SHAR_EOF
if test 357 -ne "`wc -c 'InOut.c'`"
then
    echo shar: error transmitting "'InOut.c'" '(should have been 357 characters)'
fi
#    End of shell archive
exit 0
--
UUCP: ..!{allegra,decvax,seismo}!rochester!ken ARPA: [e-mail]
USnail:    Dept. of Comp. Sci., U. of Rochester, NY 14627. Voice: Ken!